#!/usr/bin/perl

######################################################################
package Swignition::RdfXmlParser;
######################################################################

use RDF::Redland;
use Swignition::GenericParser;
use utf8;
use strict;

use vars qw(@ISA);
@ISA = qw(Swignition::GenericParser);

sub new
{
	my $class    = shift;
	my $source   = shift;
	my $opts     = shift;
	my $this     = Swignition::GenericParser::object_structure($source, $opts);
	
	bless $this, $class;	
	
	$this->find_base_uri;

	if ($this->{options}->{p_AUTO})
	{
		$this->redland_parse('rdfxml');

		Swignition::GenericParser::HTTP::consume($this)
			if Swignition::GenericParser::HTTP::is_enabled($this);

		Swignition::GenericParser::Recursive::consume($this)
			if Swignition::GenericParser::Recursive::is_enabled($this);

		$this->smush;
	}

	return $this;	
}

sub redland_parse
{
	my $this   = shift;
	my $type   = shift;
	my $source = shift || $this->{Source};
	my $graph0 = shift || $this->graph;
	my $graph1 = shift || $this->graph($this->uri);
	
	my $baseobj = new RDF::Redland::URI($this->uri);
	my $parser  = new RDF::Redland::Parser($type);
	my $stream;
	
	if (! eval { $stream = $parser->parse_string_as_stream($source, $baseobj); } )
	{
		# Funny little way of outputting an error message.
		$graph0->quick_rrl(
			$this->uri,
			'http://www.w3.org/2000/01/rdf-schema#comment',
			"Could not parse as RDF ($type).",
			undef,
			'en');
		return 0;
	}
	
	while ($stream && !$stream->end)	
	{
		my $statement = $stream->current;
		
		my $subj = $statement->subject;
		my $prop = $statement->predicate;
		my $obj  = $statement->object;
		
		next if ($subj->is_literal || $prop->is_literal);
		
		my $subj_uri = $subj->is_resource ? $subj->uri->as_string : '_:'.$subj->blank_identifier;
		my $prop_uri = $prop->is_resource ? $prop->uri->as_string : '_:'.$prop->blank_identifier;
		
		my $triple;
		
		if ($obj->is_literal)
		{
			$triple = $graph1->quick_rrl(
				$subj_uri,
				$prop_uri,
				$obj->literal_value,
				($obj->literal_datatype ? $obj->literal_datatype->as_string : undef),
				$obj->literal_value_language);
		}
		else
		{
			my $obj_uri = $obj->is_resource ? $obj->uri->as_string : '_:'.$obj->blank_identifier;

			$triple = $graph1->quick_rrr(
				$subj_uri,
				$prop_uri,
				$obj_uri);
		}
		
		$graph0->add_triple($triple);
		
		$stream->next;
	}

	if ($type eq 'n3' || $type eq 'turtle')
	{
		while ($this->{Source} =~ / \@prefix \s+ ([A-Za-z0-9_-]*) \s* \: \s* <([^>]+)> \s* \. /gx)
		{
			my $nsurl  = $2;
			my $prefix = length($1) ? $1 : 'p1';
			$this->mergeNS($prefix, $nsurl, "RDF $prefix", -1, 0);
		}
	}
	elsif ($RDF::Redland::VERSION gt '1.00_06_00')
	{
		my %ns = $parser->namespaces_seen;
		foreach my $k (keys %ns)
		{
			$this->mergeNS($k, $ns{$k}->as_string, "RDF $k", -1, 0);
		}
	}
	elsif ($type eq 'rdfxml')
	{
		while ($source =~ /xmlns\:?([A-Za-z0-9_-]*)\=\"([^"]*)\"/g)
		{
			my $nsurl  = $2;
			my $prefix = length($1) ? $1 : 'p1';
			$this->mergeNS($prefix, $nsurl, "RDF $prefix", -1, 0);
		}
		while ($source =~ /xmlns\:?([A-Za-z0-9_-]*)\=\'([^']*)\'/g)
		{
			my $nsurl  = $2;
			my $prefix = length($1) ? $1 : 'p1';
			$this->mergeNS($prefix, $nsurl, "RDF $prefix", -1, 0);
		}
	}
	
	return 1;
}

1;
